#
# Execution counting and slowing module.
#
# Intended usage:
# - Each time a particular function is called,
#   Malus::note(function, caller) is called.
#   This increases the malus of that pair by 1.
# - If the malus count of a function/caller pair is over a threshold value,
#   Malus::punish(function, caller) will wait a while.
# - Malus::creditall will reduce the malus of all entries.
#   Entries with malus <= 0 are deleted.
#
# Apache seems to kill off very long-running processes, but the clients
# don't stop polling because of this. So there needs to be an upper bound.
# This is "killlimit" - which will hold for 4 minutes.
# Calling program must do something sensible with the result returned.
#

package Malus;

use strict;

use vars qw($punishlimit $killlimit $DEBUG);

$punishlimit = 25; # Was 50
$killlimit = 50; # Was 240
$DEBUG = 0;

# This is just to get access to FT's DBI handle...
#use FileTable;
# and using Counter, not FileTable, to get the init routines right
use Counter;

# garg...
FileTable::dbconnect() if !$FileTable::dbhandle;

sub note {
    my $function = shift;
    my $caller = shift;

    my $dbh = $FileTable::dbhandle;
    my $sth = $dbh->prepare("update malus set count=count+1, date=now() where func=? and caller=?");
    my $status = $sth->execute($function, $caller);
    if (!$status) {
	# Start handling error cases
	if ($sth->errstr =~ /doesn't exist/) { # '
	    $DEBUG && warn "Creating table\n";
	    $sth = $dbh->prepare("create table malus (func varchar(40) not null, caller varchar(40) not null, count int, date datetime, unique rowdef(func, caller))");
	    $status = $sth->execute();
	    die "Error" if !$status;
	    $sth = $dbh->prepare("insert into malus set func=?, caller=?, count=1, date=now()");
	    $status = $sth->execute($function, $caller);
	    die "Error" if !$status;
	    $DEBUG && warn "Inserted entry $function $caller into table\n";
	} else {
	    die "Error";
	}
    } elsif ($status == 0) {
	# record did not exist
	$sth = $dbh->prepare("insert into malus set func=?, caller=?, count=1, date=now()");
	$status = $sth->execute($function, $caller);
	die "Error" if !$status;
	$DEBUG && warn "Inserted entry $function $caller into table\n";

    } else {
	$DEBUG && warn "Updated entry $function $caller in table\n";
    }
}

sub punish {
    my $function = shift;
    my $caller = shift;

    my $dbh = $FileTable::dbhandle;
    my $sth = $dbh->prepare("select count from malus where func=? and caller=?");
    my $status = $sth->execute($function, $caller);
    if ($status) {
	my $res = ($sth->fetchrow_array)[0];
	if ($res) { # count found
	    if ($res > $killlimit) {
		warn "Angry at $caller $function for $res\n";
		sleep($killlimit);
		return 2;
	    } elsif ($res > $punishlimit) {
		warn "Punishing $caller $function for $res\n";
		sleep($res - $punishlimit);
		return 1;
	    } else {
		$DEBUG && warn "Not punishing $caller $function for $res\n";
		return 0;
	    }
        } else {
	    return 0;
	}
    }
}

sub creditall {    
    my $function = shift;
    my $credit = shift;

    $credit = 1 if !defined($credit);
    my $dbh = $FileTable::dbhandle;
    my $sth = $dbh->prepare("update malus set count=count-? where func=?");
    my $status = $sth->execute($credit, $function);
    if (!$status) {
	# Start handling error cases
	die "Error";
    }
    $sth = $dbh->prepare("delete from malus where func=? and count < 1");
    $status = $sth->execute($function);
    if (!$status) {
	# Start handling error cases
	die "Error";
    }
}
    
